with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Ada.Exceptions;

with Win32;
with Win32.Winnt;
with Interfaces.C; use Interfaces.C;
with System.Storage_Elements; use System.Storage_Elements;
with System; use System;

package body win32api_interface.memory.helper is

  type Access_String is access String;
  procedure Free is new Ada.Unchecked_Deallocation(String, Access_String);

  function null_string (l : in integer) return string is
    result : Access_String := new String (1..l);
  begin
    for i in 1..result'last loop
      result.all(i) := character'val(0);
    end loop;
    return result.all;
  end null_string;

  ----------------
  -- Read_Bytes --
  ----------------

  function Read_Bytes(HProc  : in Handle;
                      Target : in Address;
                      Length : in Integer) return string is
    str : string(1..length);
  begin
    str := Read_Process_Memory (HProc, Target, Length);
    return str;
  exception
    when Semi_Read_Error =>
      return str;
    when Win32_Error =>
      raise Read_Bytes_Error;
  end Read_Bytes;

  ------------------
  -- Follow_Pointer --
  ------------------

  function Follow_Pointer(HProc  : in Handle;
                          Target : in Address) return Address is
    type fourbytes is new string(1..4);

   function fourbytes_to_Address is new
     Ada.Unchecked_Conversion(source => fourbytes, target => Address);
  begin
    return fourbytes_to_Address(fourbytes(Read_Bytes (HProc, Target, 4)));
--    exception
--      when others => return fourbytes_to_uinteger(fourbytes(null_string(4)));
  end Follow_Pointer;

  --------------------
  -- Read_Int2bytes --
  --------------------

  function Read_Int2bytes(HProc  : in Handle;
                          Target : in Address) return Integer is
    function fourbytes_to_Integer is new
     Ada.Unchecked_Conversion
    (source => fourbytes,
     target => Integer);
  begin
    return fourbytes_to_Integer(fourbytes(
      Read_Bytes (HProc, Target, 2)&character'val(0)&character'val(0)));
--    exception
--      when others => return fourbytes_to_Integer(fourbytes(null_string(4)));
  end Read_Int2bytes;

  -------------------
  -- Read_Int1byte --
  -------------------

  function Read_Int1byte(HProc  : in Handle;
                         Target : in Address) return Integer is
   function fourbytes_to_Integer is new
     Ada.Unchecked_Conversion
    (source => fourbytes,
     target => Integer);
  begin
    return fourbytes_to_Integer
      (fourbytes(Read_Bytes(HProc, Target, 1)&
       character'val(0)&character'val(0)&character'val(0)));
--    exception
--      when others => return fourbytes_to_Integer(fourbytes(null_string(4)));
  end Read_Int1byte;

  -----------------
  -- Write_Bytes --
  -----------------

  procedure Write_Bytes(HProc  : in Handle;
                        Target : in Address;
                        Value  : in String) is
  begin
    Write_Process_Memory(HProc, Target, Value);
  end Write_Bytes;

  procedure Write_Int(HProc  : in Handle;
                      Target : in Address;
                      Value  : in Integer) is
    function Integer_to_fourbytes is new
     Ada.Unchecked_Conversion
    (source => Integer,
     target => fourbytes);
  begin
    Write_Bytes(HProc, Target, string(Integer_to_fourbytes(Value)));
  end Write_Int;

  ---------------------
  -- Get_Memory_Info --
  ---------------------

  procedure Get_Memory_Info (HProc : in Handle) is
    Info : PROCESS_MEMORY_COUNTERS;
  begin
    Info := Get_Process_Memory_Info (HProc);
  end Get_Memory_Info;

  ------------------
  -- Min_App_Addr --
  ------------------

  function Min_App_Addr return Address is
  begin
    Return Get_System_Info.lpMinimumApplicationAddress;
  end Min_App_Addr;

  ------------------
  -- Max_App_Addr --
  ------------------

  function Max_App_Addr return Address is
  begin
    Return Get_System_Info.lpMaximumApplicationAddress;
  end Max_App_Addr;

  -----------------------
  -- Get_Memory_Status --
  -----------------------

  function Get_Memory_Status return Memorystatus is
  begin
    Return Global_Memory_Status;
  end Get_Memory_Status;

  ----------------------
  -- Get_Max_Pagefile --
  ----------------------

  function Get_Max_Pagefile return Address is
  begin
    return To_Address(Integer_Address(Get_Memory_Status.dwTotalPageFile));
  end Get_Max_Pagefile;

  ---------------------
  -- Get_Max_Virtual --
  ---------------------

  function Get_Max_Virtual return Address is
  begin
    return To_Address(Integer_Address(Get_Memory_Status.dwTotalVirtual));
  end Get_Max_Virtual;

  ----------------
  -- Find_Bytes --
  ----------------

  function Find_Bytes(HProc : in Handle;
                      Query : in String;
                      From  : in Address := Min_App_Addr;
                      To    : in Address := Max_App_Addr) return results is
    si : SYSTEM_INFO;
    mbi : MEMORY_BASIC_INFORMATION;
    lpMem, maxAddr : Address;
    ResultAddresses : results;

    procedure search_in_region (rsize : in integer) is
      sBuffer : Access_String := new String (1..rsize);

      procedure search (query : in string; on : in string) is
        i, j : Storage_Offset;
      begin
        i := 1; j := 1;
        while i < on'length loop
          while on(Integer(i)) /= query(Integer(j)) and i < on'length loop
            i:= i+1;
          end loop;
          while on(Integer(i)) = query(Integer(j))
            and j < query'length and i < on'length loop
             i := i+1; j := j+1;
          end loop;
          if query(Integer(j)) = on(Integer(i))
            and ResultAddresses.n < ResultAddresses.pos'length then
            ResultAddresses.n := ResultAddresses.n+1;
            ResultAddresses.pos(ResultAddresses.n) := mbi.BaseAddress + i - j;
          end if;
          j:= 1;
        end loop;
      end search;
    begin
      sBuffer.all := Read_Bytes(HProc,
                                mbi.BaseAddress,
                                integer(mbi.RegionSize));
      search (Query, sBuffer.all);
      Free(sBuffer);
    exception
      when others =>
        search (Query, sBuffer.all); ----
        Free(sBuffer); --raise;
    end search_in_region;

  begin
    ResultAddresses.n := 0;
    si := Get_System_Info;
    lpMem := si.lpMinimumApplicationAddress;
    if lpMem < From then lpMem := From; end if;
    MaxAddr := si.lpMaximumApplicationAddress;
    if si.lpMaximumApplicationAddress > To then
      MaxAddr := To;
    end if;
    while lpMem < MaxAddr loop
      mbi.RegionSize := 0; -- per?
      mbi := Virtual_Query_Ex(HProc, lpMem);
      --Put_Line("rSize: "&Integer'Image(integer(mbi.RegionSize)));
      if mbi.State = Win32.Winnt.MEM_COMMIT
        --and mbi.C_Type = Win32.Winnt.MEM_PRIVATE
      then
        --Put_Line("mbi.State = Win32.Winnt.MEM_COMMIT");
        if mbi.RegionSize > 0 then
          search_in_region (integer(mbi.RegionSize));
        end if;
      end if;
      lpMem := mbi.BaseAddress + Storage_Offset(mbi.RegionSize);
    end loop;
    return ResultAddresses;
  end Find_Bytes;

  function Find_Pointer(HProc : in Handle; Query : in Address;
                        From  : in Address := Min_App_Addr;
                        To    : in Address := Max_App_Addr) return Results is
    function Address_to_fourbytes is new
      Ada.Unchecked_Conversion(Address, fourbytes);
  begin
    Return Find_Bytes(HProc, String(Address_to_fourbytes(Query)), From, To);
  end Find_Pointer;

  -- Data types conversion functions

  function fourbytes_to_float (four : in fourbytes) return float is
    function fourtofloat is new
      Ada.Unchecked_Conversion(fourbytes, float);
  begin
    return fourtofloat(four);
  end fourbytes_to_float;

  function float_to_fourbytes (num : in float) return fourbytes is
    function floattofour is new
      Ada.Unchecked_Conversion(float, fourbytes);
  begin
    return floattofour(num);
  end float_to_fourbytes;

  function byte_to_integer    (inbyte : in character) return integer is
    function charactertobyte is new
      Ada.Unchecked_Conversion(character, byte);
  begin
    return integer(charactertobyte(inbyte));
  end byte_to_integer;
end win32api_interface.memory.helper;
